home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / GRAPHICS / TS32 / COLORPAL.INT < prev    next >
Text File  |  1996-03-21  |  3KB  |  107 lines
  1. (***************************************************
  2. TColorPalette->TComponent
  3.  
  4. Manages a 256 color logical palette.
  5.  
  6. Properties
  7.  
  8. BadEntries-
  9.   If this palette is not an identity palette, this StringList
  10.   will contain the palette entries that are responsible and
  11.   require alteration.
  12. IdentityPalette-
  13.   Indicates whether this palette qualifies as an identity palette.
  14. ImagePalette-
  15.   Assigning this property to a TImage on the form causes the
  16.   palette of the TImage to be copied into the TColorPalette.
  17.   The reference to the TImage is not maintained, but the physical
  18.   palette data is.
  19. PalEntryFlag-
  20.   Indicates if the palette entries should be flagged as PC_NOCOLLAPSE
  21.   or PC_RESERVED.  The recommended setting is PC_NOCOLLPASE.
  22. Palette-
  23.   The HPalette handle that corresponds to the logical palette.
  24. PaletteEntry[n]-
  25.   Accesses the palette entry structure at the specified index.
  26.   When modifying palette entries, call the Refresh method
  27.   to regenerate the palette.
  28. PaletteEntries-
  29.   In design mode brings up a property editor that allows you
  30.   to manipulate the palette visually.
  31.  
  32. Events
  33.  
  34. Methods
  35.  
  36. Refresh-
  37.   Causes the logical palette to regenerate.  Call this after changing
  38.   PaletteEntry values.
  39. ***************************************************)
  40.  
  41. unit ColorPalette;
  42.  
  43. interface
  44.  
  45. uses
  46.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  47.   ExtCtrls, Utility, DsgnIntf;
  48.  
  49. type
  50.  
  51.   EPalette = class( Exception );
  52.  
  53.   TPAL = record
  54.      logPalette: TLogPalette;
  55.      palpalEntry: array[0..255] of TPaletteEntry;
  56.   end;
  57.  
  58.   TPalEntryFlag = ( pcNoCollapse, pcReserved );
  59.  
  60.   TColorPalette = class( TComponent )
  61.   private
  62.      bEntries: boolean;
  63.      FEntries: TStrings;
  64.      FFlag: TPalEntryFlag;
  65.      FFlag_: byte;
  66.      FPalette: HPALETTE;
  67.      pal: TPAL;
  68.      FImage: TImage;
  69.      bDummy: boolean;
  70.      nDummy: integer;
  71.      FBadEntries: TStrings;
  72.      procedure PaletteEntriesToStrings;
  73.      procedure SetPaletteHandle( bStoreStrings: boolean );
  74.   protected
  75.      procedure Loaded; override;
  76.      procedure SetFlag( f: TPalEntryFlag );
  77.      procedure SetImage( im: TImage );
  78.      procedure SetEntries( str: TStrings );
  79.      function IsIdentityPalette: boolean;
  80.      procedure SetBadEntry( str: TStrings );
  81.      function GetPaletteEntry( n: byte ): TPaletteEntry;
  82.      procedure SetPaletteEntry( n: byte; pal: TPaletteEntry );
  83.   public
  84.      constructor Create( AOwner: TComponent ); override;
  85.      destructor Destroy; override;
  86.      procedure Assign( Source: TPersistent ); override;
  87.      procedure Refresh;
  88.      property Palette: HPALETTE read FPalette write FPalette;
  89.      property PaletteEntry[n: byte]: TPaletteEntry read GetPaletteEntry write SetPaletteEntry;
  90.   published
  91.      property BadEntries: TStrings read FBadEntries write SetBadEntry;
  92.      property PaletteEntries: TStrings read FEntries write SetEntries;
  93.      property ImagePalette: TImage read FImage write SetImage;
  94.      property IdentityPalette: boolean read IsIdentityPalette write bDummy;
  95.      property PalEntryFlag: TPalEntryFlag read FFlag write SetFlag default pcNoCollapse;
  96.   end;
  97.  
  98.   TColorPaletteEditor = class( TPropertyEditor )
  99.   private
  100.   protected
  101.   public
  102.      procedure Edit; override;
  103.      function GetAttributes: TPropertyAttributes; override;
  104.      function GetValue: string; override;
  105.   end;
  106.  
  107. procedure Register;